perm filename TTYINT.CHG[NEW,LSP] blob
sn#390673 filedate 1978-10-23 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00009 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 Here are the changes for sail ttyint in READER
C00024 00003 In *LISP
C00032 00004 In *LISP
C00040 00005 In *LISP
C00042 00006 ESC I fixes in *LISP
C00056 00007 In QIO
C00074 00008 In QIO
C00086 00009 In QIO
C00098 ENDMK
C⊗;
;;; Here are the changes for sail ttyint in READER
;;; MAIN INPUT FILE ARRAY HANDLER
;;; FILE ARRAY IN VINFILE.
;;; SAVES A,B,C,AR2A; CLOBBERS AR1.
;;; RETURNS CHARACTER IN TT.
;;; ACCUMULATOR D IS ZERO FOR PEEKING, ELSE 1.
$PEEK: TDZA D,D
$DEVICE: MOVEI D,1
$DEV0: PUSHJ P,INFGET ;GETS VINFILE IN AR1
SKIPE TAPRED
CAIN AR1,TRUTH
HRRZ AR1,V%TYI
IFN SFA,[
MOVSI T,AS.SFA ;BREAK AWAY HERE IF SFA
TDNN T,ASAR(AR1) ;SFA?
JRST $DEV0Z ;NOPE, CONTINUE AS USUAL
PUSH FXP,D ;SAVE D OVER CALL
PUSH P,A
PUSH P,B
PUSH P,C
PUSH P,AR1
PUSH P,AR2A
SETZ C, ;NIL AS OP DEPENDENT ARGS
JUMPE D,$DEVPE ;PEEKING, MIGHT HANDLE THE SFA DIFFERENTLY
HRLZI T,SO.TYI ;WE ARE DOING A TYI
$DEVP1: PUSHJ P,ISTCAL ;INTERNAL SFA CALL, SFA IN AR1
$DEVP2: POP P,AR2A
POP P,AR1
POP P,C
POP P,B
POP FXP,D
SKIPE A ;ALLOW NIL
JSP T,FXNV1 ;INSURE FIXNUM AND GET INTO TT
JUMPN A,POPAJ ;IF NON-NIL THEN GOT SOMETHING, SO RETURN IT
MOVNI TT,1
JUMPE D,POPAJ ;ONLY PEEKING, SO MERELY RETURN -1
PUSHJ P,EOF ;SIGNAL EOF
POP P,A
JRST $DEVICE ;RETRY IF WE SURVIVE
$DEVPE: MOVEI TT,SR.WOM ;CHECK THE WHICH-OPERATIONS MASK FOR TYIPEEK
MOVSI T,SO.TIP
TDNE T,@TTSAR(A) ;CAN IT DO IT?
JRST $DEVP1 ;YES, DO IT DIRECTLY
MOVSI T,SO.TYI ;ELSE DO IT AS TYI/UNTYI
MOVEI AR1,(A) ;STREAM IN AR1 FOR ISTCAL
PUSHJ P,ISTCAL ;DO THE TYI
JUMPE A,$DEVP2 ;HIT EOF
PUSH P,A ;REMEMBER THE CHAR WE WERE HANDED
MOVSI T,SO.UNT ;NOW UNTYI THE CHARACTER
MOVEI C,(A) ;THE ARG IS THE CHARACTER
MOVE A,-2(P) ;GET THE SFA AS FIRST ARG
PUSHJ P,ISTCAL ;DO THE UNTYI
POP P,A ;FUDGE THE CHARACTER AS THE RETURNED VALUE
JRST $DEVP2
$DEV0Z: ] ;END IFN SFA
MOVSI T,TTS.CL
TDNE T,TTSAR(AR1)
JRST $DVLUZ ;INPUT (FILE) CLOSED LOSSAGE!
.5LOCKI
MOVE T,TTSAR(AR1)
; SKIPE FI.BBF(T) ;BUFFERED-BACK FORMS NOT IMPLEMENTED YET
; JRST $DEVER
SKIPN TT,FI.BBC(T)
JRST $DEV2
TLZN TT,200000
JRST $DEV1
HLRZ TT,TT
SKIPE D
HRRZS FI.BBC(T)
$DEV0B: TRZN TT,100000 ;100000 MEANS DON'T OUTPUT TO ECHOFILES
JRST $DEV7
UNLKPOPJ .SEE UNTYI
$DEV1: MOVS TT,(TT)
SKIPE D
HLRZM TT,FI.BBC(T)
MOVE TT,(TT)
JRST $DEV0B
$DVLUZ: PUSHJ P,INFLZZ
JRST $DEV0
$DEV2: HLRZ R,BFPRDP
TLNN T,TTS<TY> ;IF THIS ISN'T A TTY,
JRST $DEV4 ; THEN FORGET CLEVER HACKS
CAIN R,Q%TYI ;IF THIS IS TYI, THEN
JRST $DEV4H ; PULL CLEVER ACTIVATION HACK
JUMPE R,$DEV4 ;NIL MEANS NO CLEVERNESS AT ALL
HRRZ R,TI.BFN(T) ;FORGET PRE-SCAN IF THERE IS
JUMPE R,$DEV4Q ; NO PRE-SCAN FUNCTION
$DEV2B: HRLM D,(P)
PUSHJ FXP,SAV5 ;OTHERWISE SAVE THE WORLD
MOVEI A,(AR1) ;INVOKE THE PRE-SCAN FUNCTION
HLRZ B,BFPRDP ; WITH THREE ARGUMENTS:
MOVEI AR2A,(R) ; (1) THE FILE ARRAY
UNLOCKI ; (2) THE FUNCTION TO BUFFER FOR
LDB T,[002100,,BFPRDP] ; (3) IF (2) IS 'READ, THE
PUSH FXP,T ; NUMBER OF HANGING OPEN
MOVEI C,(FXP) ; PARENTHESES
CALLF 3,(AR2A)
SUB FXP,R70+1
HRRZ AR1,-1(P)
JUMPN A,$DEV2D ;NIL MEANS OVER-RUBOUT, ERGO EOF
JSP R,PDLA2-5
JRST $DEV4D
$DEV2D: MOVEI C,(A)
SKIPE V.RSET
CAIN R,QTTYBUF ;DON'T NEED TO CHECK RESULT IF
JRST $DEV2P ; IT WAS OUR OLD FRIEND TTYBUF
MOVEI B,(C)
$DEV2E: JUMPE B,$DEV2P
HLRZ A,(B)
JSP F,TYOARG
HRRZ B,(B)
JRST $DEV2E
$DEV2P: HRRZ AR1,-1(P)
MOVEI TT,FI.BBC
HRRZM C,@TTSAR(AR1)
JSP R,PDLA2-5
HLRZ D,(P)
JRST $DEV0
$DEV4Q: MOVE F,F.MODE(T)
TLNN F,FBT<FU> ;IF TTY DOESN'T HAVE 12.-BIT
JRST $DEV4 ; CHARS, THEN WE ARE WINNING
UNLOCKI
PUSHJ P,INFLUZ ;OTHERWISE WE LOSE
JRST $DEV0
20$ $DEV4H:
$DEV4: SKIPL F,F.MODE(T) .SEE FBT.CM
JRST $DEV5
IFN ITS,[
MOVE R,F.CHAN(T)
LSH R,27
IOR R,[.IOT 0,TT]
SPECPRO INTTYX
TYIXCT: XCT R ;INPUT CHARACTER
NOPRO
$DEV4B: JUMPL TT,$DEV4A ;JUMP ON EOF
AOS F.FPOS(T) ;OTHERWISE INCREMENT FILE POSITION (OK EVEN IF F.FLEN NEG)
JRST $DEV6
] ;END OF IFN ITS
IFN D20,[
PUSHJ FXP,SAV3
HRRZ 1,F.JFN(T)
MOVE 2,[444400,,TT]
MOVNI 3,1
SPECPRO INTTYX
TYIXCT: SIN ;INPUT CHARACTER
NOPRO
MOVE R,3
PUSHJ FXP,RST3
JUMPN R,$DEV4A ;JUMP ON EOF
AOS F.FPOS(T) ;OTHERWISE INCREMENT FILE POSITION (OK EVEN IF F.FLEN NEG)
JRST $DEV6
] ;END OF IFN D20
IFN D10,[
SA$ $DEV4C: ;SAIL WANT'S LINMOD CHECK EVEN FOR TYI
MOVE R,[INCHWL TT]
TLNN F,FBT.LN
SA% $DEV4C:
MOVE R,[INCHRW TT]
SPECPRO INTTYX
TYIXCT: XCT R
NOPRO
IFN SAIL,[
TRNE F,10 ;FORGET THIS HACK FOR IMAGE MODE
JRST $DEV6
MOVEI R,(TT) ;CANONICALIZE ASCII CODES
; CAIN R,32 ;TILDE: 32 => 176
; HRROI R,176
; CAIN R,176 ;RIGHT BRACE: 176 => 175
; HRROI R,175
; CAIN R,175 ;ALTMODE: 175 => 33
; HRROI R,33
; CAIN R,33 ;NOT EQUALS: 33 => 32
; HRROI R,32
ANDI TT,600
IORI TT,(R)
TLNE F,FBT.FU ;IF FULL CHARACTER SET (BUCKY BITS),
JRST $DEV4S ; DON'T DO ANY CONVERSIONS
CAIGE TT,40 ;A CONTROL CHARACTER?
ADDI TT,%TXCTL+"@ ;YES, CONVERT TO EXTENDED ASCII FORMAT
;check for control OR meta
trnn tt,%txctl $DEV4S: TRNN TT,%TXCTL ;USE PRESENCE OF CONTROL BIT TO CHECK FOR INT
+%txmta
JRST $DEV6
;flush this stuff
; PUSH FXP,TT ;SAVE THE ACTUAL CHARACTER
; SUBI TT,%TXCTL+"@
; CAIL TT,"a-"@ ;IS IT A LOWER CASE LETTER?
; CAILE TT,"z-"@
; SKIPA ;NOPE, LEAVE ALONE
; SUBI TT,"a-"@-1 ;ELSE CONVERT TO REAL CONTROL CHARACTER
; SKIPL TT
; CAILE TT,"← ;IS IT A REAL "CONTROL" CHARACTER?
; JRST $DEV4V ;NO, FIXUP THE WORLD AND PROCEED
] ;END OF IFN SAIL
SA% CAIL TT,40 ;CONTROL CHARS CAUSE AN INTERRUPT WHEN READ
SA% JRST $DEV6
$DEV4U: HRLM D,(P)
MOVEI D,(TT) ;ONLY INTERRUPT IF INT FUNCTION EXISTS
ROT D,-1 ;CLEVER ARRAY ACCESS AS PER TTYICH
ADDI D,FB.BUF(T)
PUSH FXP,R
HLRZ R,(D)
SKIPGE D
HRRZ R,(D)
JUMPE R,$DEV4Z
MOVEI D,400000(TT)
HRLI D,(AR1) ;THERE IS NO OBVIOUS NEED FOR THIS NOW
PUSHJ P,UCHINT ;GIVE USER INTERRUPT FOR TTY INT CHAR
$DEV4Z: POP FXP,R
HLRZ D,(P)
;flush
; IFN SAIL,[
; $DEV4V: POP FXP,TT ;RESTORE THE CONTROL CHARACTER
; ] ;END IFN SAIL
JRST $DEV6
] ;END OF IFN D10
$DEV4A: UNLOCKI ;COME HERE ON EOF
$DEV4D: MOVNI TT,1
JUMPE D,CPOPJ ;ONLY PEEKING, SO MERELY RETURN -1
PUSHJ P,EOF ;SIGNAL EOF
JRST $DEVICE ;RETRY IF WE SURVIVE
;;; A TRICKY HACK TO BE CLEVER ABOUT IMMEDIATE ACTIVATION
;;; WHEN TYI (OR READCH, OR WHATEVER) IS INVOLVED.
IFN D10,[
$DEV4H: SKIPL F,F.MODE(T) ;MUST BE THE TTY FOR THIS TO WORK
JRST $DEV5
JRST $DEV4C ;IGNORE LINE MODE, AND USE CHARACTER INPUT UUO
] ;END OF IFN D10
IFN ITS,[
$DEV4H: SKIPL F,F.MODE(T)
JRST $DEV5 ;BUFFERED TTY INPUT??? OH WELL.
SPECPRO INTTYX
TYICAL: .CALL $DEV4M ;GOBBLE CHAR, EVEN IF NOT ACTIVATED
NOPRO
.LOSE 1400
MOVE TT,TTSAR(AR1)
SKIPN R,FT.CNS(TT)
JRST $DEV4K ;DONE IF NO ASSOCIATED OUTPUT TTY
HRLM D,(P)
MOVE TT,TTSAR(R) ;UPDATE CHARPOS AND LINENUM FROM CURSOR
PUSH FXP,T
PUSHJ FXP,CLRO4 ; POSITION OF ASSOCIATED OUTPUT TTY
POP FXP,T
HLRZ D,(P)
MOVE TT,TTSAR(AR1)
$DEV4K: EXCH T,TT
JRST $DEV4B
$DEV4M: SETZ
SIXBIT \IOT\ ;I/O TRANSFER
5000,,%TIACT ;READ CHARACTER IMMEDIATELY EVEN IF NOT ACTIVATOR
,,F.CHAN(T) ;CHANNEL #
402000,,T ;SINGLE CHAR RETURNED HERE (T, NOT TT!)
] ;END OF IFN ITS
$DEV5F: PUSHJ P,$DEV5K
JRST $DEV4A
$DEV5:
10$ HRRZ TT,FB.HED(T)
10$ SOSGE 2(TT)
10% SOSGE FB.CNT(T) ;GOBBLE NEXT INPUT CHAR
JRST $DEV5F ;MAY NEED TO GET NEW BUFFER
10$ ILDB TT,1(TT)
10% ILDB TT,FB.BP(T)
$DEV6: JUMPN D,$DEV6B
MOVEI D,(TT)
ANDI D,177+%TXCTL ;? THIS MAY SCREW CONTROL CHARS ON SAIL
TRZN D,%TXCTL
JRST $DEV6A
CAIE D,177
TRZ D,140
$DEV6A: TRO D,200000
HRLM D,FI.BBC(T)
SETZ D,
$DEV6B: CAIN TT,↑J
AOS AT.LNN(T)
CAIE TT,↑L
JRST $DEV7
SETZM AT.LNN(T)
AOS AT.PGN(T)
$DEV7: SKIPE AR1,VECHOFILES ;SKIP UNLESS ECHO FILES
SKIPN D ;DON'T ECHO PEEKED-AT CHARS
UNLKPOPJ
HRLI AR1,200000 ;LIST OF FILES, NO TTY
HRLM TT,AR2A
PUSH P,AR2A
JSP T,GTRDTB ;GET READTABLE
LDB TT,[220700,,(P)] ;WATCHIT! CHAR COULD BE 12. BITS
PUSHJ P,TYO6 ;PUSH CHAR INTO ALL ECHO FILES
HLRZ TT,(P)
POP P,AR2A
UNLKPOPJ
;;; INPUT BUFFER FILL ROUTINE. EXPECTS TTSAR IN T.
;;; SKIPS *UNLESS* NO CHARACTERS READ DUE TO EOF.
;;; SAVES D AND F.
.SEE FPOS5
$DEV5K: PUSH FXP,D
MOVE D,FB.BVC(T) ;GET NUMBER OF VALID BYTES
ADDM D,F.FPOS(T) ;STEP CURRENT FILE POSITION BY THAT AMOUNT
SETZM FB.BVC(T)
IFN ITS,[
EXCH T,TT
MOVE D,FB.BFL(TT) ;BYTE COUNT
MOVE T,FB.IBP(TT) ;BYTE POINTER
TYICA1: .CALL SIOT
.LOSE 1400
EXCH T,TT
SUB D,FB.BFL(T) ;NEGATIVE OF NUMBERS OF BYTES READ
MOVNM D,FB.CNT(T)
MOVNM D,FB.BVC(T)
JUMPE D,POPXDJ ;JUMP OUT ON EOF
] ;END OF IFN ITS
IFN D10,[
MOVE TT,F.CHAN(T)
LSH TT,27
TLO TT,(IN 0,)
XCT TT ;READ A NEW BUFFERFUL
JRST $DEV5M ;SUCCESS!
XOR TT,[<STATO 0,IO.EOF>#<IN 0,>]
XCT TT
HALT ;? LOSEY LOSEY
SA$ MOVE D,FB.HED(T)
SA$ MOVE TT,2(D)
SA$ MOVEM TT,FB.BVC(T)
SA$ SKIPG TT
JRST POPXDJ
$DEV5M: MOVE D,FB.HED(T)
MOVE TT,2(D) ;NUMBER OF VALID BYTES
MOVEM TT,FB.BVC(T)
] ;END OF IFN D10
IFN D20,[
PUSHJ FXP,SAV3 ;PRESERVE LOW THREE AC'S
HRRZ 1,F.JFN(T)
MOVE 2,FB.IBP(T)
MOVN 3,FB.BFL(T)
SIN ;READ A BUFFERFUL
ADD 3,FB.BFL(T)
MOVEM 3,FB.CNT(T) ;STORE COUNT OF BYTES READ IN FILE OBJECT
MOVEM 3,FB.BVC(T)
MOVE D,3
PUSHJ FXP,RST3
JUMPE D,POPXDJ ;NO BYTES READ => EOF
] ;END OF IFN D20
10% MOVE TT,FB.IBP(T)
10% MOVEM TT,FB.BP(T) ;INITIALIZE BUFFER POINTER
POP FXP,D
JRST POPJ1 ;SKIP RETURN ON SUCCESS
$DEVER: UNLOCKI
SETO TT,
JUMPE D,CPOPJ
PUSH P,CPOPNVJ
MOVEI A,(AR1)
PUSHJ P,NCONS
MOVEI B,Q%TYI
PUSHJ P,XCONS
IOL [CAN'T TYI - FORM(S) PENDING!]
INFGT0: PUSHJ P,INFLUZ
INFGET: SKIPN AR1,VINFILE ;GET VINFILE IN AR1
JRST INFGT0
POPJ P,
INFLZZ: SKIPA T,[[SIXBIT \INFILE CLOSED!\]]
INFLUZ: MOVEI T,[SIXBIT \BAD VALUE FOR INFILE!\]
PUSH P,A
MOVEI A,TRUTH ;INFILE IS A LOSER!
EXCH A,VINFILE
PUSH P,CPOPAJ
%FAC (T)
] ;END OF IFN QIO
;;; In *LISP
;;; IFN QIO
;;; INTERRUPT FROM I/O CHANNEL.
;;; PRESENTLY ONLY TWO KINDS ARE HANDLED:
;;; TTY INPUT: INTERRUPT CHAR TYPED.
;;; TTY OUTPUT: **MORE**.
CHNINT: MOVE F,INTPDL
MOVE D,IPSWD2(F) ;GET WORD TWO INTERRUPT BITS
MOVE R,FXP ;FXP MAY BE IN A BAD STATE IF
SKIPE GCFXP ; WITHIN GC, SO RESTORE IT AND
MOVE FXP,GCFXP ; THEN PUSH ITS OLD VALUE
PUSH FXP,R ;REMEMBER, PDL OVERFLOW ISN'T DEFERRED NOW
IFN ITS,[
MOVN R,D
AND R,D ;R GETS LOWEST SET BIT
ANDCM D,R ;D GETS ALL OTHER BITS
SKIPE D
.SUSET [.SIIFPIR,,D] ;PUT ANY OTHER BITS BACK (THEY'RE DEFERRED)
MOVE D,R
JFFO D,.+1 ;FIND CHANNEL NUMBER
MOVNS R ; FOR SOME PENDING
ADDI R,43 ; INTERRUPT BIT
PUSH FXP,R ;SAVE CHANNEL NUMBER
SKIPN R ;CHANNEL 0 ??
JRST CHNI2 ;YES, THIS CAN HAPPEN IN STRANGE CASES
SKIPN CHNTB(R) ;UNOPEN DEVICE ??
.VALUE ;BUT DON'T ALLOW INTERRUPTS FROM CLOSED CHAN
CHNI1H: .CALL SCSTAT ;GET STATUS FOR THE CHANNEL
.VALUE
ANDI D,77 ;GET ITS INTERNAL PHYSICAL DEVICE TYPE
SKIPE D
CAILE D,2
JRST CHNI5
];END IFN ITS
IFN D10+D20,[
MOVE R,D
PUSH FXP,V%TYI ;SAR ADR ON STACK
] ;END IFN D10+D20
IFN ITS,[
HRRZ D,CHNTB(R)
MOVE D,TTSAR(D)
TLNE D,TTS<IO>
JRST CHNI5
.ITYIC R, ;TYPE 0 IS TTY INPUT
JRST CHNI8 ;TIMING ERROR OR SOMETHING - IGNORE
] ;END IFN ITS
IFN D10,[
TRNE R,400000 ;IF NOT INTERNAL GET FROM USE
JRST CHNIZ ;ELSE WE HAVE ALREADY
OUTCHR ["?]
INCHRW R
sa$ tro r,200 ;controlify it
CHNIZ:
] ;END IFN D10
; or somesuch - flush non-SAIL ascii bits
ifn d10+d20,[
sa$ andi r,777 IFN D10+D20, ANDI R,37 ;MAP ALL CHARS INTO CTRL CHARACTERS
sa% andi r,37 PUSH FXP,R ;SAVE INTERRUPT CHARACTER
] ;end ifn ... PUSH FXP,TT ; AND ALSO TT
HRRZ TT,-2(FXP) ;FETCH CHANNEL NUMBER
;FOR D-10, THIS IS ADR OF SAR
TTYI1:
IT$ HRRZ TT,CHNTB(TT)
HRRZ TT,TTSAR(TT)
IFN D10+D20,[
HRL TT,F.CHAN(TT) ;NOW GET CHANNEL #
HLRZM TT,-2(FXP) ;MAKE THE CHANNEL NUMBER CORRECT ON THE STACK
] ;END IFN D10+D20
JSP D,TTYICH ;GET BACK INTERRUPT FN IN R
POP FXP,TT
JUMPE R,CHNI2 ;NULL FUNCTION - IGNORE
MOVEI D,(R)
LSH D,-SEGLOG
MOVE D,ST(D)
TLNN D,FX
JRST CHNI4
MOVE R,(R) ;"FUNCTION" IS A FIXNUM
IFN ITS+SAIL,[
MOVEI D,(R) ;IF ANY OF THE SUPRA-ASCII
ANDCM D,(FXP) ; MODIFIER BITS ARE SET IN THE
MOVSS (FXP) ; "FUNCTION", INSIST THAT THE
ANDM R,(FXP) ; CORRESPONDING BITS APPEAR IN
MOVSS (FXP) ; THE CHARACTER TYPED. SIMILARLY,
IOR D,(FXP) ; THE SAME BITS SET IN THE LEFT HALF
TRNE D,%TX<MTA+CTL+TOP+SFT+SFL> ; MEAN THAT THOSE BITS MUST BE OFF.
JRST CHNI2
] ;END IFN ITS+SAIL
; this table is the same. Change fb.buf instead
ANDI R,177
MOVEI D,TRUTH ;MOOOOBY SKIP CHAIN OF SYSTEM INTS
CAIN R,↑C ;↑C (SETQ ↑D NIL)
SETZM GCGAGV
CAIN R,↑D ;↑D (SETQ ↑D T)
HRRZM D,GCGAGV
CAIN R,↑G ;↑G (↑G) ;QUIT
JRST CN.G
CAIN R,↑R ;↑R (SETQ ↑R T)
HRRZM D,TAPWRT
CAIN R,↑T ;↑T (SETQ ↑R NIL)
SETZM TAPWRT
CAIN R,↑V ;↑V (SETQ ↑W NIL)
SETZM TTYOFF
CAIN R,↑W ;↑W (PROG2 (SETQ ↑W T)
JRST CN.W ; (CLEAR-OUTPUT T))
CAIN R,↑X ;↑X (ERROR 'QUIT) ;↑X QUIT
JRST CN.X
CAIN R,↑Z ;↑Z CRAP OUT TO DDT
JRST CN.Z
CHNI2: SUB FXP,R70+2
JRST INTXIT
;;; In *LISP
;;; IFN QIO
SUBTTL INITIAL TTY INPUT FILE ARRAY
-F.GC,,TTYIF2 ;GC AOBJN POINTER
TTYIF1: JSP TT,1DIMS
TTYIFA ;POINTER BACK TO SAR
0 ;ILLEGAL FOR USER TO ACCESS - DIMENSION IS ZERO
TTYIF2:
OFFSET -.
FI.EOF:: NIL ;EOF FUNCTION (??)
FI.BBC:: 0,,NIL ;BUFFERED BACK CHARS
FI.BBF:: NIL ;BUFFERED BACK FORMS
TI.BFN:: QTTYBUF ;PRE-SCAN FUNCTION
FT.CNS:: TTYOFA ;ASSOCIATED TTY OUTPUT FILE
REPEAT 3, 0 ;UNUSED SLOTS
F.MODE:: SA% FBT.CM,,2 ;MODE (ASCII TTY IN SINGLE)
SA$ FBT.CM\FBT.LN,,2
F.CHAN:: -1 ;CHANNEL # (INITIALLY ILLEGAL)
20$ F.JFN:: .PRIIN ;JFN (FOR D20 ONLY)
20% 0
F.FLEN:: -1 ;WE EXPECT RANDOM ACCESS TO BE ILLEGAL
F.FPOS:: 0 ;FILE POSITION
REPEAT 3, 0 ;UNUSED SLOTS
IFN ITS+D10,[
F.DEV:: SIXBIT \TTY\ ;DEVICE
IT$ F.SNM:: 0 ;SNAME (FILLED IN)
10$ F.PPN:: 0 ;PPN (FILLED IN)
F.FN1::
IT$ SIXBIT \.LISP.\ ;FILE NAME 1
10$ SIXBIT \LISP\
F.FN2::
IT$ SIXBIT \INPUT\ ;FILE NAME 2
10$ SIXBIT \IN\
F.RDEV:: BLOCK 4 ;TRUE FILE NAMES
] ;END OF IFN ITS+D10
IFN D20,[
F.DEV:: ASCII \TTY\
] ;END OF IFN D20
LOC TTYIF2+LOPOFA
IFN ITS+D20+SAIL,[
TI.ST1::
IT$ STTYW1 ;TTY STATUS WORDS
20$ CCOC1
SA$ SACTW1
TI.ST2::
IT$ STTYW2
20$ CCOC2
SA$ SACTW2
SA$ TI.ST3:: SACTW3
SA$ TI.ST4:: SACTW4
SA% BLOCK 2
] ;END OF IFN ITS+D20+SAIL
.ELSE BLOCK 4
0 .SEE ATO.LC
AT.CHS:: 0 ;CHARPOS
AT.LNN:: 0 ;LINENUM
AT.PGN:: 0 ;PAGENUM
BLOCK 10
LONBFA:: BLOCK 10
;INTERRUPT FUNCTIONS
FB.BUF::
;the intial fb.buf table contains as the only upper/lower pairs:
; ↑G,↑g => quit
; ↑Z,↑z => DDT
;check this carefully.
IFN SAIL,[
REPEAT 100, NIL,,NIL ;alphabetic (ascii 0 through ascii 177)
REPEAT 40, NIL,,NIL ;low control ↑<null>-↑A (200-301)
QCN.BB,,IN0+↑C ;↑B ↑B-BREAK ↑C GC STAT OFF
IN0+↑D,,NIL ;↑D GC STAT ON ↑E
NIL,,IN0+↑G ;↑F ↑G HARD QUIT
REPEAT 3, NIL,,NIL ;↑H-↑M (FORMAT EFFECTORS)
NIL,,NIL ;↑N ↑O
NIL,,NIL ;↑P ↑Q
IN0+↑R,,IN0+↑W ;↑R UWRITE ON? ↑S ↑W INT, ↑V MACRO
IN0+↑T,,NIL ;↑T UWRITE OFF? ↑U
IN0+↑V,,IN0+↑W ;↑V TTY ON ↑W TTY OFF
IN0+↑X,,NIL ;↑X SOFT QUIT ↑Y
IN0+↑Z,,NIL ;↑Z GO TO DDT ↑[
REPEAT 5, NIL,,NIL ;↑\ ↑↑e
NIL,,IN0+↑G ;↑f ↑g
REPEAT 11, NIL,,NIL ;↑h-↑y (ascii 350-372)
IN0+↑Z,,NIL ;↑z ↑{
REPEAT <NASCII/2>-<.-FB.BUF>, NIL,,NIL ;ALL OTHERS INITIALLY UNUSED
]
.ELSE,[
NIL,,NIL ;↑@ ↑A
QCN.BB,,IN0+↑C ;↑B ↑B-BREAK ↑C GC STAT OFF
IN0+↑D,,NIL ;↑D GC STAT ON ↑E
NIL,,IN0+↑G ;↑F ↑G HARD QUIT
REPEAT 3, NIL,,NIL ;↑H-↑M (FORMAT EFFECTORS)
NIL,,NIL ;↑N ↑O
NIL,,NIL ;↑P ↑Q
IN0+↑R,,IN0+↑W ;↑R UWRITE ON? ↑S ↑W INT, ↑V MACRO
IN0+↑T,,NIL ;↑T UWRITE OFF? ↑U
IN0+↑V,,IN0+↑W ;↑V TTY ON ↑W TTY OFF
IN0+↑X,,NIL ;↑X SOFT QUIT ↑Y
IN0+↑Z,,NIL ;↑Z GO TO DDT ≠ <ALTMODE>
NIL,,NIL ;↑\ CONTROL RIGHT-BRACKET
NIL,,NIL ;↑↑ ↑←
REPEAT <NASCII/2>-<.-FB.BUF>, NIL,,NIL ;ALL OTHERS INITIALLY UNUSED
]
OFFSET 0
;;; In *LISP
;;; IFN QIO
;;; TTSAR OF TTY INPUT FILE ARRAY IN TT.
;;; INPUT INTERRUPT CHARACTER IN R.
;;; RETURN ADDRESS IN D.
;;; RETURNS INTERRUPT FUNCTION IN R.
TTYICH:
; or somesuch - flush non-SAIL ASCII bits
it$ trz r,%tx<top-sfl+sft+mta>
sa$ andi r,777 IFN ITS+SAIL, TRZ R,%TX<TOP+SFL+SFT+MTA>;FOLD 12.-BIT CHAR
sa% TRZN R,%TX<CTL> ; DOWN TO 7 IF NECESSARY
sa% JRST TTYIC1
sa% CAIE R,177
sa% TRZ R,140
TTYIC1: ROT R,-1 ;CLEVER ARRAY ACCESS
ADDI TT,FB.BUF(R) ;INTERRUPT FNS ARE IN "BUFFER"
HLR R,(TT)
SKIPGE R
HRRZ R,(TT) ;SIGN BIT OF R GETS CLEARED
JRST (D)
;;; ESC I fixes in *LISP
;;; IFN QIO
IFN SAIL,[
;SAIL NEWIO INTERRUPT CODE
;CALLED TO REINITIALIZE THE INTERRUPT SYSTEM
ENBINT: MOVEI T,INTRPT ;FLAGS,,INTERRUPT LOCATION
MOVEM T,.JBAPR ;LOCATION SO MONITOR KNOWS
SETZM INTALL ;DID A 'DALINT' LAST (ALL INTS ARE MASKED)
SETOB T,REEINT ;ALL INTERRUPTS INCLUDING REENTER
SETOM REENOP ;BUT MUST SET BOTH FLAGS
IWKMSK T ;ALL GET US OUT OF IWAIT
INTMSK T ;ALL ARE MASKED ON
MOVE T,[STDMSK] ;ENABLE STANDARD INTERRUPTS
MOVEM T,IMASK ;THIS IS CURRENT INTERRUPT MASK
MOVEM T,OIMASK ;THIS IS ALSO THE OLD-MASK
INTENB T, ;TELL OPERATING SYSTEM WHICH INTS TO GENERATE
MOVEI T,REETRP ;REENTER TRAP ADR
MOVEM T,.JBREN ;ALLOW REENTER AS MEANS OF IOC INTERRUPT
POPJ P,
;REENABLES INTERRUPTS AFTER THEY HAVE BEEN DISABLED BY DALINT OR DISINT
REAINT: PUSH FXP,T
AOSE INTALL ;DISABLED ALL INTS?
SKIPA T,OIMASK ;NO, USE OLD INTERRUPT MASK
SKIPA T,IMASK ;ELSE USE CURRENT MASK
MOVEM T,IMASK ;THIS IS NOW THE CURRENT MASK
INTMSK T ;THEN UNMASK CORRECT SET OF INTERRUPTS
SKIPG REEINT
JRST REAIN1
MOVEI T,CPOPJ
MOVEM T,.JBOPC
POP FXP,T
JRST REETR1 ;FUDGE A REENTER IF ONE WAS REQUESTED
REAIN1: POP FXP,T
SETOM REEINT
POPJ P,
;DISABLE ALL BUT IMPORTANT INTERRUPTS
;IMASK IS MOVED TO OIMASK, AND IMASK IS SETUP TO NEW CURRENT MASK VALUE
DISINT: PUSH FXP,T ;WE WILL NEED A WORKING AC
MOVE T,IMASK ;GET CURRENT INTERRUPT MASK
MOVEM T,OIMASK ;UPDATE OLD MASK
ANDCM T,[INTPAR\INTPOV\INTILM\INTNXM] ;ONLY ALLOW THESE INTERRUPTS
MOVEM T,IMASK ;NEW MASK
INTMSK T ;TELL OPERATING SYSTEM
SETZM REEINT ;ALSO DISALLOW REENTERS
POP FXP,T
POPJ P,
;THIS ROUTINE DISABLES ALL INTERRUPTS FROM OCCURING
;THE FLAG INTALL IS SET SAYING TO TELL THE RE-ENABLE ROUTINE TO RESTORE
; INTERRUPTS FROM IMASK RATHER THAN OIMASK
DALINT: INTMSK R70 ;MASK OFF ALL INTERRUPTS
SETOM INTALL ;FLAG THAT ALL INTERRUPTS HAVE BEEN DISABLED
POPJ P,
;HERE TO PROCESS AN INTERRUPT
;OPERATING SYSTEM JUMPS TO HERE WITH ALL ACS SAVED AND SET UP WITH INTERRUPT
;STATUS; THE OBJECT IS TO SAVE INTERRUPT DEPENDANT DATA AND THEN REENABLE
;THE INTERRUPT SYSTEM AS SOON AS POSSIBLE....NOTE THAT THIS MUST DISABLE
;INTERRUPTS DEPENDING UPON WHICH ONE WAS GENERATED.
;--INTERRUPT-- --DISABLES--
;MEMORY ERROR ALL EXCEPT PDL OV
;<ESC>I <ESC>I AND REENTER
;PDL OV ALL EXCEPT MEMORY ERROR AND PDL OV
;CLOCK CLOCK
INTRPT: MOVE A,INTPDL ;DON'T WORRY ABOUT SPACEWAR BUTTONS
SETZM REENOP ;NO ↑C/REENTER TRAPS NOW
MOVE B,.JBCNI ;GET INTERRUPT
PUSH A,B ;SAVE INTERRUPT CONDITIONS
PUSH A,10 ;SAVE ARGUMENT TO INTERRUPT (FOR <ESC>I)
;this push ↑ is useless for now.
;the way this interrupt works is
;you type <esc>nI or <break>nI
;the <esc> vs <break> is in the sign bit,
;while the n is in reg. 10. The normal mode
;of operation is <esc>I followed by INCHWR
PUSH A,IMASK ;DEFERRED INTERRUPT MASK CURRENTLY ACTIVE
JFFO B,.+1 ;GET INTERRUPT NUMBER INTO AC B+1
PUSH A,B+1 ;STORE THIS ON INTPDL
PUSH A,.JBTPC ;SAVE ADR INTERRUPT EMANATES FROM
PUSH A,NIL ;SAVE DUMMY WORDS TO HOLD ACS D, R, F
PUSH A,NIL
PUSH A,NIL
MOVEM A,INTPDL ;THIS IS NEW INTERRUPT PDL POINTER
UWAIT ;UWAIT WILL RESTORE USER AC'S
EXCH F,INTPDL ;SAVE F, GET POINTER TO INTPDL
MOVEM D,IPSD(F) ;SAVE D
MOVEM R,IPSR(F) ;SAVE R
MOVEI R,(F) ;COPY INTPDL INTO R
EXCH F,INTPDL ;RESTORE STATE OF F AND INTPDL
MOVEM F,IPSF(R) ;THEN SAVE F
MOVE F,IPSDF2(R) ;GET BIT NUMBER
MOVE R,SAIIMS(F) ;THIS WILL BE NEW IMASK (F HAS INT NUMBER)
MOVEM R,IMASK
INTMSK R
DEBREAK ;NOW GO TO USER LEVEL BUT NOT TO USER PROGRAM
JRST @SAIDSP(F) ;DISPATCH ON INTERRUPT INDEX
;DISMISS AN INTERRUPT
DSMINT: PUSH FXP,T
MOVE T,INTPDL
MOVE F,IPSDF1(T) ;RESTORE APR FLAGS TO THOSE AT INTERRUPT TIME
MOVEM F,IMASK
INTMSK F
POP T,F
POP T,R
POP T,D
PUSH P,(T) ;RETURN PC
POPI T,5
MOVEM T,INTPDL ;RESTORE INTPDL
POP FXP,T
SKIPL REEINT
HALT ;FOR DEBUGGING, THIS SHOULD NOT HAPPEN UNLESS
;CODE IS NOT PAIRED CORRECTLY
; (DISINT[DALINT]/REAINT)
SKIPG REENOP
POPJ P,
MOVEM T,REESVT ;WE NEED AT LEAST ONE AC
MOVE T,INTPDL ;USE T AS THE INTPDL
ADD T,R70+10 ;WE MUST RESERVE THE SPACE WE WILL NEED
MOVEM T,INTPDL
SUB T,R70+5 ;BUT LEAVE 4 DUMMY WORDS + 1 FOR PC
POP P,(T) ;PC IS THAT WHICH WE WILL POPJ TO
JRST REETR1
;INTERRUPT HANDLING ROUTINES (DISPATCHED TO VIA SAIDSP)
INTERR: OUTSTR [ASCIZ\AN ILLEGAL INTERRUPT HAS BEEN RECIEVED. THIS IS AN
INTERNAL LISP ERROR\]
HALT
PARINT: MOVSI R,(%PIPAR) ;FLAG THAT IS PARITY ERROR
JRST SAIMER
NXMINT: SKIPA R,[%PIMPV]
ILMINT: MOVSI R,(%PIWRO)
SAIMER: MOVE F,INTPDL ;INT PDL POINTER INTO F
MOVEM R,IPSWD1(F) ;STORE WHERE MEMERR CAN FIND BITS
JRST MEMERR ;PROCESS MEMORY ERROR
;HERE FOR <ESC>I INTERRUPT
EYEINT: MOVE F,INTPDL ;INT PDL POINTER INTO F
; MOVM R,IPSWD2(F) ;GET <ESC>I ARG (POSITIVE FORM ONLY)
; CAILE R,177 ;ONLY CHARACTERS UP TO 177 HAVE MEANING
; TDZA R,R ;FORCE R TO ZERO
; TLO R,400000 ;FLAG THAT THIS IS AN INTERNAL CALL
clrbfi ;clear input buffers
setz r, ;external call
MOVEM R,IPSWD2(F) ;RESTORE ARGUMENT TO CHNINT
JRST CHNINT ;FUDGE THE CHANNEL INTERRUPT
;NEW INTERRUPT MASK BITS, INDEXED BY CURRENT INTERRUPT NUMBER
SAIIMS: 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ;NOT CURRENTLY ENABLED AT ANY TIME
INTPOV ;PAR ERROR: ONLY ALLOW PDL OV
-INTCLK-1 ;CLOCK INT: ALLOW ALL OTHERS
0 ? 0 ? 0 ? 0 ;NOT USED, IMP INTERRUPTS
-<INTCLK\INTTTI>-1 ;<ESC>I: ALL EXCEPT <ESC>I AND CLOCK
0 ;CHANGING QUEUES, NOT USED
INTPOV\INTILM\INTNXM\INTPAR\INTPOV ;PDL OV: ALL MEMORY ERRS AND PDL OV
0 ;PDP-11 INT, NOT USED
INTPOV ;ILM: ONLY PDL OV
INTPOV ;NXM: ONLY PDL OV
0 ? 0 ? 0 ;OVERFLOW AND OLD CLOCK TICK
;DISPATCH TABLE, INDEXED BY INTERRUPT NUMBER
SAIDSP:
REPEAT 11,INTERR ;INTERRUPT ERROR, THIS CANNOT HAPPEN
PARINT ;PARITY ERROR
CLOCKI ;CLOCK INTERRUPT
INTERR ? INTERR ? INTERR ? INTERR ;VARIOUS IMP INTERRUPTS
EYEINT ;<ESC>I INTERRUPT
INTERR ? INTERR ? INTERR ;CHANGING QUEUES, UNUSED, UNUSED
PDLOV ;PDL OV
INTERR ? INTERR ;PDP-11 INTERRUPT, UNUSED
ILMINT ;ILL MEM REF
NXMINT ;NON-EXISTANT MEMORY
INTERR ? INTERR ? INTERR ;UNUSED, UNUSED, OLD CLOCK INT
INTERR ? INTERR ;UNUSED
INTERR ;FLOATING OVERFLOW
INTERR ? INTERR ;UNUSED
INTERR ;INTEGER OVERFLOW
REPEAT 4, INTERR ;UNUSED
] ;END IFN SAIL
;;; In QIO
SUBTTL CONVERSION: NAMESTRING => SIXBIT
;;; THIS ONE IS PRETTY HAIRY. IT CONVERTS AN ATOMIC
;;; SYMBOL IN A, REPRESENTING A FILE SPECIFICATION,
;;; INTO "SIXBIT" FORMAT ON FXP. THIS INVOLVES
;;; PARSING A FILE NAME IN STANDARD ASCII STRING FORMAT
;;; AS DEFINED BY THE HOST OPERATING SYSTEM.
;;; FOR D20, THE OPERATING SYSTEM GIVES US SOME HELP.
;;; FOR ITS AND D10, WE ARE ON OUR OWN.
IFN ITS+D10,[
;;; THE GENERAL STRATEGY HERE IS TO CALL PRINTA TO EXPLODEC THE NAMESTRING.
;;; A PARSING COROUTINE TAKES THE SUCCESSIVE CHARACTERS AND INTERPRETS THEM.
;;; EACH COMPONENT IS ASSEMBLED IN SIXBIT FORM, AND WHEN IT IS TERMINATED
;;; BY A BREAK CHARACTER, IT IS PUT INTO ONE OF FOUR SLOTS RESERVED ON FXP.
;;; FOR CMU, WE ALSO ASSEMBLE THE CHARACTERS INTO PNBUF IN ASCII FORM,
;;; SO THAT WE CAN USE THE CMUDEC UUO TO CONVERT A CMU-STYLE PPN.
;;; AR1 HOLDS THE BYTE POINTER FOR ACCUMULATING A NAME.
;;; AR2A HOLDS MANY FLAGS DESCRIBING THE STATE OF THE PARSE:
NMS==:1,,525252 ;FOR BIT-TYPEOUT MODE
NMS.CQ==:1 ;CONTROL-Q SEEN
NMS.CA==:2 ;CONTROL-A SEEN
IFN D10,[
NMS.DV==:10 ;DEVICE SEEN (AND TERMINATING :)
NMS.FN==:20 ;FILE NAME SEEN
NMS.DT==:40 ;. SEEN
NMS.XT==:100 ;EXTENSION SEEN
NMS.LB==:200 ;LEFT BRACKET SEEN
NMS.CM==:400 ;COMMA SEEN
NMS.RB==:1000 ;RIGHT BRACKET SEEN
NMS.ND==:10000 ;NON-OCTAL-DIGIT SEEN
NMS.ST==:20000 ;* SEEN
] ;END OF IFN D10
;;; CONTROL-A IS THE SAIL CONVENTION FOR QUOTING MANY CHARACTERS, BUT WE
;;; ADOPT IT FOR ALL ITS AND D10 SYSTEMS.
NMS6B0: WTA [BAD NAMESTRING!]
NMS6BT: MOVEI TT,(A) ;DON'T ALLOW FIXNUMS AS NAMESTRINGS
LSH TT,-SEGLOG
MOVSI R,FX
TDNE R,ST(TT) ;A FIXNUM?
JRST NMS6B0 ;YES, ILLEGAL AS A NAMESTRING
PUSHN FXP,L.F6BT+1 ;FOUR WORDS FOR FINISHED NAMES, ONE FOR ACCUMULATION
MOVEI AR1,(FXP) ;AR1 HOLDS THE BYTE POINTER FOR ACCUMULATING A NAME
HRLI AR1,440600
SETZ AR2A, ;ALL FLAGS INITIALLY OFF
CMU$ PUSH FXP,PNBP ;FOR CMU, WE NEED THIS TO PARSE THE PPN
CMU$ SETZM PNBUF+LPNBUF-1
HRROI R,NMS6B1 .SEE PR.PRC
PUSH P,A
PUSHJ P,PRINTA ;PRINTA WILL CALL NMS6B1 WITH SUCCESSIVE CHARS IN A
TLNE AR2A,NMS.CA+NMS.CQ
JRST NMS6B0 ;ILLEGAL FOR A QUOTE TO BE HANGING
MOVEI A,40
PUSHJ P,(R) ;FORCE A SPACE THROUGH TO TERMINATE LAST COMPONENT
POP P,A
IFN D10,[
TLNE AR2A,NMS.LB
TLNE AR2A,NMS.RB
CAIA
JRST NMS6B0 ;LOSE IF LEFT BRACKET SEEN BUT NO RIGHT BRACKET
] ;END OF IFN D10
JUMPE AR1,NMS6B0 ;AR1 IS ZEROED IF THE PARSING CORUTINE DETECTS AN ERROR
POP FXP,1+CMU
MOVSI T,(SIXBIT \*\) ;CHANGE ANY ZERO COMPONENTS TO "*"
SKIPN -3(FXP)
MOVEM T,-3(FXP) ;DEVICE NAME
IT$ SKIPN -2(FXP)
IT$ MOVEM T,-2(FXP) ;SNAME
IFN D10,[
MOVE TT,-2(FXP) ;TREAT HALVES OF PPN SEPARATELY
TLNN TT,-1 ;A ZERO HALF BECOMES -1
TLO TT,-1
TRNN TT,-1
TRO TT,-1
MOVEM TT,-2(FXP)
] ;END OF IFN D10
SKIPN -1(FXP)
MOVEM T,-1(FXP) ;FILE NAME 1
SKIPN (FXP)
MOVEM T,(FXP) ;FILE NAME 2/EXTENSION
POPJ P,
;;; THIS IS THE NAMESTRING PARSING COROUTINE
NMS6B1: JUMPE AR1,CPOPJ ;ERROR HAS BEEN DETECTED, FORGET THIS CHARACTER
CAIN A,↑A
JRST NMS6BQ
CAIN A,↑Q
TLCE AR2A,NMS.CQ ;FOR A CONTROL-Q, SET THE CONTROL-Q BIT
CAIA ;IF IT WAS ALREADY SET, IT'S A QUOTED ↑Q
POPJ P, ;OTHERWISE EXIT
CAIN A,40 ;SPACE?
TLZN AR2A,NMS.CQ ;YES, QUOTED?
SKIPA ;NO TO EITHER TEST
JRST NMS6B9 ;YES TO BOTH, IS QUOTED SPACE
CAILE A,40 ;SKIP OF CONTROL CHARACTER OR SPACE
JRST NMS6B7
;WE HAVE ENCOUNTERED A BREAK CHARACTER - DECIDE WHAT TO DO WITH COMPONENT
NMS6B8: SKIPN D,(AR1)
POPJ P, ;NO CHARACTERS ASSEMBLED YET
IT$ SKIPN -2(AR1) ;IF WE HAVE A FILE NAME 1, THIS MUST BE FN2
10$ TLNN AR2A,NMS.DT ;WE HAVE SEEN A DOT, THIS MUST BE THE EXTENSION
JRST NMS6B5 ;OTHERWISE THIS IS FILE NAME 1
IT$ SKIPE -1(AR1) ;LOSE IF WE ALREADY HAVE A FILE NAME 2
10$ TLNE AR2A,NMS.XT+NMS.LB+NMS.CM+NMS.RB
JRST NMS6BL ;LOSE IF EXTENSION AFTER BRACKETS OR OTHER ONE
IT$ MOVEM D,-1(AR1)
10$ HLLZM D,-1(AR1)
10$ TLO AR2A,NMS.XT ;SET FLAG: WE'VE SEEN THE EXTENSION
;COME HERE TO RESTORE THE BYTE POINTER FOR THE NEXT COMPONENT
NMS6B6: JUMPE AR1,CPOPJ ;IF AN ERROR HAS BEEN DETECTED, EXIT
HRLI AR1,440600
CMU$ MOVE D,PNBP ;FOR CMU, RESET THE PNBUF BYTE POINTER ALSO
CMU$ MOVEM D,1(AR1)
10$ TLZ AR2A,NMS.ND+NMS.ST ;RESET NON-OCTAL-DIGIT AND STAR SEEN FLAGS
SETZM (AR1) ;CLEAR ACCUMULATION WORD
POPJ P,
;COME HERE FOR FILE NAME 1
NMS6B5:
10$ TLNE AR2A,NMS.FN+NMS.DT+NMS.XT+NMS.LB+NMS.CM+NMS.RB
10$ JRST NMS6BL ;LOSE IF TOO LATE FOR A FILE NAME
MOVEM D,-2(AR1) ;SAVE FILE NAME 1
JRST NMS6B6
;HERE WITH A NON-CONTROL NON-SPACE CHARACTER
NMS6B7: TLZN AR2A,NMS.CQ
TLNE AR1,NMS.CA
JRST NMS6B9 ;IF CHARACTER QUOTED (FOR ↑Q, FLAG IS RESET)
CAIN A,":
JRST NMS6DV ;: SIGNALS A DEVICE NAME
IT$ CAIN A,";
IT$ JRST NMS6SN ;; MEANS AN SNAME
IFN D10,[
CAIN A,".
JRST NMS6PD ;PERIOD MEANS TERMINATION OF FILE NAME
CAIN A,133
JRST NMS6LB ;LEFT BRACKET
CAIN A,",
JRST NMS6CM ;COMMA
CAIN A,135
JRST NMS6RB ;RIGHT BRACKET
CAIN A,"*
JRST NMS6ST ;STAR
] ;END OF IFN D10
;HERE TO DUMP A CHARACTER INTO THE ACCUMULATING COMPONENT
NMS6B9:
IFN CMU,[
SKIPE PNBUF+LPNBUF-1
TDZA AR1,AR1 ;ASSUME A COMPONENT THAT FILLS PNBUF IS A LOSER
IDPB A,1(AR1) ;STICK ASCII CHARACTER IN PNBUF
] ;END OF IFN CMU
IFN D10,[
CAIL A,"0
CAILE A,"7
TLO AR2A,NMS.ND ;SET FLAG IF NON-OCTAL-DIGIT
NMS6B4:
] ;END OF IFN D10
CAIGE A,140 ;CONVERT LOWER CASE TO UPPER,
SUBI A,40 ; AND ASCII TO SIXBIT
TLNE AR1,770000
IDPB A,AR1 ;DUMP CHARACTER INTO ACCUMULATING NAME
POPJ P,
NMS6BQ: TLCA AR2A,NMS.CA ;COMPLEMENT CONTROL-A FLAG
NMS6BL: SETZ AR1, ;ZEROING AR1 INDICATES A PARSE ERROR
POPJ P,
NMS6DV: SKIPE D,(AR1) ;ERROR IF : SEEN WITH NO PRECEDING COMPONENT
10$ ;ERROR AFTER OTHER CRUD
10$ TLNE AR2A,NMS.DV+NMS.FN+NMS.DT+NMS.XT+NMS.LB+NMS.CM+NMS.RB
10% SKIPE -4(AR1) ;ERROR IF DEVICE NAME ALREADY SEEN
JRST NMS6BL
MOVEM D,-4(AR1)
10$ TLO AR2A,NMS.DV
JRST NMS6B6 ;RESET BYTE POINTER
IFN ITS,[
NMS6SN: SKIPE D,(AR1) ;ERROR IF ; SEEN WITHOUT PRECEDING COMPONENT
SKIPE -3(AR1) ;ERROR IF WE ALREADY HAVE AN SNAME
JRST NMS6BL
MOVEM D,-3(AR1)
JRST NMS6B6 ;RESET BYTE POINTER
] ;END OF IFN ITS
IFN D10,[
NMS6PD: TLNE AR2A,NMS.DT+NMS.XT+NMS.LB+NMS.CM+NMS.RB
JRST NMS6BL
PUSHJ P,NMS6B8 ;DOT SEEN - SEE IF IT TERMINATED THE FILE NAME
TLO AR2A,NMS.DT ;SET PERIOD (DOT) FLAG
POPJ P,
NMS6LB: TLNE AR2A,NMS.LB+NMS.CM+NMS.RB
JRST NMS6BL ;LEFT BRACKET ERROR IF ALREADY A BRACKET
PUSHJ P,NMS6B8 ;DID WE TERMINATE THE FILE NAME OR EXTENSION?
TLO AR2A,NMS.LB ;SET LEFT BRACKET FLAG
;was this a typo? Just doesn't make sense if you are
;still using sixbit.
sa$ NMS6L1: HRLI AR1,440300
sa% NMS6L1: HRLI AR1,440600
POPJ P,
NMS6CM: LDB D,[360600,,AR1]
CAIE D,44 ;ERROR IF NO CHARACTERS AFTER LEFT BRACKET
TLNN AR2A,NMS.LB ;ERROR IF NO LEFT BRACKET!
JRST NMS6BL
;our ppn's have non-octal digits
sa% TLNE AR2A,NMS.ND+NMS.CM+NMS.RB
sa$ TLNE AR2A,NMS.CM+NMS.RB
JRST NMS6BL ;ERROR IF NON-OCTAL-DIG, COMMA, OR RGT BRACKET
PUSHJ P,NMS6PP ;HACK HALF A PPN
HRLM D,-3(AR1)
TLO AR2A,NMS.CM ;SET COMMA FLAG
SETZM (AR1) ;CLEAR COLLECTING WORD
JRST NMS6L1 ;RESET BYTE POINTER
NMS6RB:
LDB D,[360600,,AR1]
CMU% TLNE AR2A,NMS.CM ;MUST HAVE COMMA BEFORE RIGHT BRACKET
CAIN D,44 ;ERROR IF NO CHARS SINCE COMMA/LEFT BRACKET
JRST NMS6BL
TLNE AR2A,NMS.LB ;ERROR IF NO LEFT BRACKET
TLNE AR2A,NMS.RB ;ERROR IF RIGHT BRACKET ALREADY SEEN
JRST NMS6BL
CMU$ TLNE AR2A,NMS.CM ;FOR CMU, NO COMMA MEANS A CMU-STYLE PPN
CMU$ JRST NMS6R1
PUSHJ P,NMS6PP ;FIGURE OUT HALF A PPN
HRRM D,-3(AR1)
NMS6R2: TLO AR2A,NMS.RB ;SET RIGHT BRACKET FLAG
JRST NMS6B6 ;RESET THE WORLD
IFN CMU,[
NMS6R1: MOVEI D,PNBUF
CMUDEC D, ;CONVERT CMU-STYLE PPN TO A WORD
JRST NMS6BL ;LOSE LOSE
MOVEM D,-3(AR1) ;WIN - SAVE IT AWAY
JRST NMS6R2
] ;END OF IFN CMU
NMS6ST: TLOE AR2A,NMS.ST ;SET STAR FLAG, SKIP IF NOT ALREADY SET
TLO AR2A,NMS.ND ;TWO STARS = A NON-DIGIT FOR PPN PURPOSES
JRST NMS6B4
;change this
NMS6PP: TLNE AR2A,NMS.ND
SETZ AR1, ;NON-DIGIT IN PPN IS AN ERROR
;to:
nms6pp:
;we don't require octal digits.
sa$ tlne ar2a,nms.nd
sa$ setz ar1,
HRRZI D,-1
TLNE AR2A,NMS.ST ;STAR => 777777
POPJ P,
LDB TT,[360600,,AR1]
CAIGE TT,22
SETZ AR1, ;MORE THAN SIX DIGITS LOSES
MOVNS TT
MOVE D,(AR1)
LSH D,(TT) ;RIGHT-JUSTIFY THE DIGITS
POPJ P,
] ;END OF IFN D10
] ;END OF IFN ITS+D10
;;; In QIO
SUBTTL CONVERSION: SIXBIT => NAMESTRING
;;; THIS ROUTINE TAKES A "SIXBIT" FORMAT FILE SPEC ON FXP
;;; AND GENERATES AN UNINTERNED ATOMIC SYMBOL WHOSE
;;; PRINT NAME IS THE EXTERNAL FORM OF FILE SPECIFICATION.
;;; OMITTED NAMES ARE EITHER NOT INCLUDED IN THE NAMESTRING
;;; OR REPRESENTED AS "*".
;;; THE NAMESTRING AND SHORTNAMESTRING MERELY CONVERT THEIR
;;; ARGUMENTS TO SIXBIT AND THEN INTO NAMESTRING FORM.
SHORTNAMESTRING: ;SUBR 1
TDZA TT,TT
NAMESTRING: ;SUBR 1
SETO TT,
HRLM TT,(P)
PUSHJ P,FIL6BT
6BTNMS: PUSHJ P,6BTNS ;TO MAKE A NAMESTRING, GET IT INTO PNBUF
JRST PNGNK2 ; AND THEN PNGNK2 WILL MAKE A SYMBOL
IFN D20,[
X6BTNS: MOVEI T,L.F6BT ;MAKES A STRING IN PNBUF WITHOUT REALLY
PUSH FXP,-L.F6BT+1(FXP) ; POPPING THE FILE NAMES (WE COPY THEM FIRST)
SOJG T,.-1
] ;END OF IFN D20
6BTNS: JSP T,QIOSAV ;CONVERT "SIXBIT" TO A STRING IN PNBUF
; (BETTER BE BIG ENOUGH!)
SETOM LPNF ;SET FLAG SAYING IT FITS IN PNBUF
20% MOVEI R,↑Q ;R CONTAINS THE CHARACTER FOR QUOTING
20$ MOVEI R,↑V ; PECULIAR CHARACTERS IN COMPONENTS
MOVE C,PNBP
SKIPL -6(P) ;SKIP UNLESS SHORTNAMESTRING
JRST 6BTNS0
;DEVICE NAME (NOT FOR SHORTNAMESTRING, THOUGH)
IFN ITS+D10,[
SKIPE TT,-3(FXP)
CAMN TT,[SIXBIT \*\]
JRST 6BNS0A ;JUMP IF DEVICE NAME OMITTED
] ;END OF IFN ITS+D10
IFN D20,[
SKIPN -L.6DEV-L.6DIR-L.6FNM-L.6EXT-L.6VRS+1(FXP)
JRST 6BNS0A ;JUMP IF DEVICE NAME OMITTED
MOVEI TT,-L.6DEV-L.6DIR-L.6FNM-L.6EXT-L.6VRS+1(FXP)
] ;END OF IFN D20
PUSHJ P,6BTNS1
MOVEI TT,": ;9 OUT OF 10 OPERATING SYSTEMS AGREE:
IDPB TT,C ; ":" MEANS A DEVICE NAME.
6BNS0A:
;FOR ITS AND D20, DIRECTORY NAME COMES NEXT
IFN ITS,[
SKIPE TT,-2(FXP)
CAMN TT,[SIXBIT \*\]
JRST 6BTNS0 ;DIRECTORY NAME OMITTED
PUSHJ P,6BTNS1
MOVEI TT,"; ;";" MEANS DIRECTORY NAME TO ITS
IDPB TT,C
] ;END OF IFN ITS
IFN D20,[
SKIPN -L.6DIR-L.6FNM-L.6EXT-L.6VRS+1(FXP)
JRST 6BTNS0 ;DIRECTORY NAME OMITTED
MOVEI TT,"< ;D20 DIRECTORY NAME APPEARS IN <>
IDPB TT,C
MOVEI TT,-L.6DIR-L.6FNM-L.6EXT-L.6VRS+1(FXP)
PUSHJ P,6BTNS1
MOVEI TT,">
IDPB TT,C
] ;END OF IFN D20
6BTNS0:
;NOW WE ATTACK THE FILE NAME
20% MOVE TT,-1(FXP)
20$ MOVEI TT,-L.6FNM-L.6EXT-L.6VRS+1(FXP)
PUSHJ P,6BTNS1
;NOW THE FILE NAME 2/EXTENSION/TYPE
IFN ITS, MOVEI TT,40
IFN D10+D20, MOVEI TT,".
10$ SKIPE (FXP)
IDPB TT,C
IT$ MOVE TT,(FXP)
10$ HLLZ TT,(FXP)
20$ MOVEI TT,-L.6EXT-L.6VRS+1(FXP)
IT% SKIPE TT
PUSHJ P,6BTNS1
IFN D20,[
;FOR D20, THE VERSION/GENERATION COMES LAST
WARN [HOW TO DISTINGUISH NULL VERSION FROM *?]
SKIPN -L.6VRS+1(FXP)
JRST 6BTNS8
10X MOVEI TT,";
20X MOVEI TT,".
IDPB TT,C
MOVEI TT,-L.6VRS+1(FXP)
PUSHJ P,6BTNS1
] ;END OF IFN D20
IFN D10,[
;FOR D10, THE DIRECTORY COMES LAST
MOVE TT,-2(FXP)
CAME T,XC-1 ;FORGET IT IF BOTH HALVES OMITTED
;this seems to be a typo to me.
skipg (p) SKIPL (P) ;NO DIRECTORY FOR SHORTNAMESTRING
JRST 6BTNS8
MOVEI TT,133 ;A LEFT BRACKET
IDPB TT,C
IFN CMU,[
HLRZ T,-2(FXP)
CAIG T,10 ;ONLY PROJECTS ABOVE 10 ARE IN CMU FORMAT
JRST 6BTNS4
PUSHN FXP,2 ;THERE IS A BUG IN DECCMU, BUT PUSHING ZERO WORDS
MOVEI T,-1(FXP) ; GETS US AROUND IT
HRLI T,-4(FXP)
DECCMU T,
JRST 6BTNS4 ;ON FAILURE, JUST USE DEC FORMAT
MOVEI T,-1(FXP)
TLOA T,440700
6BNS4A: IDPB TT,C ;COPY CHARACTERS INTO PNBUF
ILDB TT,T
JUMPN TT,6BNS4A
POPI FXP,2
JRST 6BTNS5
6BTNS4:
] ;END OF IFN CMU
HLLZ TT,-2(FXP)
PUSHJ P,6BTNS6 ;OUTPUT PROJECT
MOVEI TT,", ;COMMA SEPARATES HALVES
IDPB TT,C
HRLZ TT,-2(FXP)
PUSHJ P,6BTNS6 ;OUTPUT PROGRAMMER
6BTNS5: MOVEI TT,135 ;A RIGHT BRACKET
IDPB TT,C
] ;END OF IFN D10
6BTNS8: PUSHJ FXP,RDAEND ;FINISH OFF THE LAST WORD OF THE STRING
SETZM 1(C)
POPI FXP,L.F6BT ;POP CRUD OFF STACK
MOVEM C,-3(P) ;CROCK DUE TO SAVED AC C
POPJ P,
;;; COME HERE TO ADD A COMPONENT TO THE GROWING NAMESTRING IN PNBUF.
;;; FOR ITS AND D10, THE SIXBIT IS IN TT, AND MUST BE CONVERTED.
;;; FOR DEC20, TT HAS A POINTER TO THE ASCIZ STRING TO ADD.
6BTNS1:
IFN ITS+D10,[
SKIPN TT ;A ZERO WORD GETS OUTPUT AS "*"
MOVSI TT,(SIXBIT \*\)
6BTNS2: SETZ T,
LSHC T,6
JUMPE T,6BTNS3
10$ CAIE T,133-40 ;FOR DEC-10, BRACKETS MUST
10$ CAIN T,135-40 ; BE QUOTED
10$ JRST 6BTNS3
CAIE T,':
10% CAIN T,';
10$ CAIN T,'.
6BTNS3: IDPB R,C ;↑Q TO QUOTE FUNNY CHARS
ADDI T,40
IDPB T,C
JUMPN TT,6BTNS2
POPJ P,
] ;END OF IFN ITS+D10
IFN D20,[
SETZ D,
HRLI TT,440700
6BTNS2: ILDB T,TT
JUMPE T,CPOPJ
TRZE D,1 ;D IS THE PRECEDING-CHAR-WAS-↑V FLAG
JRST 6BTNS3
IRPC X,,[:;<>=←*@ ,] ;EVEN NUMBER OF GOODIES!
IFE .IRPCNT&1, CAIE T,"X
.ELSE,[
CAIN T,"X
IDPB R,C ;QUOTE FUNNY CHARACTER
] ;END OF .ELSE
TERMIN
IFN TOPS20,[ ;TOPS20 REQUIRES ADDITONAL CHARACTERS TO BE QUOTED
IRPC X,,[()[]{}/!"#%&'\|`↑}]
IFE .IRPCNT&1, CAIE T,"X
.ELSE,[
CAIN T,"X
IDPB R,C ;QUOTE FUNNY CHARACTER
] ;END OF .ELSE
TERMIN
] ;END OF IFN TOPS20
CAIN T,(R)
TRO D,1
6BTNS3: IDPB T,C
JRST 6BTNS2
] ;END OF IFN D20
IFN D10,[
;;; CONVERT ONE HALF OF A PPN, PUTTING ASCII CHARS IN PNBUF
6BTNS6: JUMPE TT,6BNS6A
CAME TT,[-1,,]
AOJA TT,6BTNS7 ;ADDING ONE PRODUCES A FLAG BIT
6BNS6A: MOVEI TT,"* ;AN OMITTED HALF IS OUTPUT AS "*"
IDPB TT,C
POPJ P,
6BNS7A: LSH TT,3+3*SAIL ;ZERO-SUPPRESS OCTAL (TOPS10/CMU), LEFT-JUSTIFY CHARS (SAIL)
6BTNS7: TLNN TT,770000←<3*<1-SAIL>>
JRST 6BNS7A ;NOTE THAT THE FLAG BIT GETS SHIFTED TOO
6BNS7B: SETZ T,
LSHC T,3+3*SAIL
SA% ADDI T,"0
SA$ ADDI T,40
IDPB T,C
TRNE TT,-1 ;WE'RE DONE WHEN THE FLAG BIT LEAVES THE RIGHT HALF
JRST 6BNS7B
POPJ P,
] ;END OF IFN D10
;;; In QIO
;FALLS IN
;STATE OF THE WORLD:
; USER INTERRUPTS LOCKED OUT
; TTSAR OF FILE ARRAY IN TT
; P: SAR FOR FILE ARRAY
; SECOND ARGUMENT TO OPEN
; FIRST ARGUMENT
; -<# OF ACTUAL ARGS>
; FXP: MODE BITS (THEY OFFICIALLY LIVE HERE, NOT IN T)
; LOCKI WORD
;PDLS MUST STAY THIS WAY FROM NOW ON FOR THE SAKE OF IOJRST'S.
.SEE OPENLZ
OPEN3: MOVE T,(FXP) ;GET MODE BITS
;NOW WE ACTUALLY TRY TO OPEN THE FILE
IFN ITS,[
MOVE D,OPEN9C(T)
TLNE T,FBT.AP ;APPEND MODE =>
TRO D,100000 ; ITS WRITE-OVER MODE
TLNE T,FBT.EC ;MAYBE OPEN AN OUTPUT TTY
TRO D,%TJPP2 ; IN THE ECHO AREA (PIECE OF PAPER #2)
.CALL OPENUP
IOJRST 4,OPNLZ0
.CALL RCHST ;READ BACK THE REAL AND TRUE NAMES
.LOSE 1400
] ;END OF IFN ITS
IFN D10,[
JUMPL T,OPEN3M .SEE FBT.CM ;NEED NOT ALLOCATE A CHANNEL FOR *THE* TTY
MOVE F,F.CHAN(TT)
;save the channel number here
sa$ movei r,(f)
MOVEI D,(F)
IMULI D,3
ADDI D,BFHD0 ;COMPUTE ADDRESS OF BUFFER HEADER
MOVEM D,FB.HED(TT) ;REMEMBER BUFFER HEADER ADR
SETZM (D) ;CLEAR BUFFER POINTER (TO FORCE NEW BUFFERS)
SETZM 1(D) ;CLEAR OLD BYTE POINTER
SETZM 2(D) ;CLEAR BYTE COUNT
TRNE T,1
MOVSS D ;IF OUTPUT BUFFER, PUT ADDRESS IN LEFT HALF
PUSH FXP,TT ;SAVE THE TTSAR
MOVE T,OPEN9C(T) ;GET THE I/O MODE FROM THE TABLE
MOVE TT,F.DEV(TT)
LSH F,27
IOR F,[OPEN 0,T]
XCT F ;OPEN THE FILE
JRST OPNAND
;then showit. Check that MIDAS knows about showit. otherwise
;calli r,400011
sa$ showit r,
MOVE R,-1(FXP) ;GET MODE BITS
XOR F,[<INBUF>#<OPEN>]
TRNE R,1
XOR F,[<OUTBUF>#<INBUF>]
MOVE TT,(FXP) ;GET BACK TTSAR
HRR F,FB.NBF(TT) ;GET NUMBER OF BUFFERS IN RH OF UUO
MOVEI TT,FB.BUF(TT)
EXCH TT,.JBFF ;.JBFF IS THE ORIGIN FOR ALLOCATING BUFFERS
XCT F ;TELL THE MONITOR TO ALLOCATE BUFFERS
MOVEM TT,.JBFF ;RESTORE OLD VALUE OF .JBFF
AND F,[0 17,] ;ISOLATE CHANNEL NUMBER AGAIN
IOR F,[LOOKUP 0,T]
MOVE TT,(FXP) ;GET TTSAR BACK IN TT
TRNE R,1 ;WE NEED TO PERFORM A LOOKUP FOR
TLNE R,FBT.AP ; EITHER IN OR APPEND MODE
CAIA
JRST OPEN3C
MOVE T,F.FN1(TT)
MOVE R,F.PPN(TT)
HLLZ TT,F.FN2(TT)
SA$ PUSHJ P,SAEXT
SETZ D,
XCT F ;PERFORM THE LOOKUP
IOJRST 4,OPNLZ1 ;LOSEY LOSEY
OPEN3C: MOVE D,-1(FXP) ;GET MODE BITS
TRNN D,1 ;NEED TO PERFORM AN ENTER FOR
JRST OPEN3D ; EITHER OUT OR APPEND MODE
XOR F,[<ENTER 0,T>#<LOOKUP 0,T>]
MOVE TT,(FXP) ;GET TTSAR
MOVE T,F.FN1(TT)
MOVE R,F.PPN(TT)
HLLZ TT,F.FN2(TT)
SA$ PUSHJ P,SAEXT
SETZ D,
XCT F ;PERFORM THE ENTER
IOJRST 4,OPNLZ1 ;LOSEY LOSEY
XOR F,[<OUT 0,>#<ENTER 0,T>]
XCT F ;SET UP BUFFER HEADER BYTE POINTER AND COUNT
;AS A RESULT OF THE LOOKUP OR ENTER, THE SIZE INFORMATION IS IN R
OPEN3D: MOVE D,TT
POP FXP,TT
HLLZM D,F.RFN2(TT) ;SAVE AWAY THE REAL, TRUE FILE NAMES
MOVEM T,F.RFN1(TT)
MOVE D,F.CHAN(TT) ;GET CHANNEL FOR DEVCHR
DEVCHR D, ;DEVICE CHRACTERISTICS
TLNE D,(DV.DIR) ;IF NON-DIRECTORY ZERO TRUENAMES
JRST OPN3D1
SETZM F.RFN2(TT)
SETZM F.RFN1(TT)
OPN3D1: MOVE D,F.CHAN(TT)
SA% DEVNAM D, ;GET REAL NAME OF DEVICE
SA$ PNAME D,
MOVE D,F.DEV(TT) ;USE GIVEN DEVICE NAME ON FAILURE
MOVEM D,F.RDEV(TT)
MOVE F,F.CHAN(TT) ;TRY TO DETERMINE REAL PPN
SA% DEVPPN F,
SA% CAIA
SA% JRST OPEN3F
SA% TRZ D,770000
CAMN D,[SIXBIT \SYS\]
JRST OPEN3E
SA% GETPPN F, ;IF ALL ELSE FAILS, ASSUME YOUR OWN PPN
SA% JFCL ;CAN'T REALLY FAIL - THIS JFCL IS FOR ULTRA SAFETY
SA$ SKIPE F,F.PPN(TT) ;IF PPN WAS SPECIFIED
SA$ JRST OPEN3F ;USE IT AS TRUE PPN
SA$ SETZ F,
SA$ DSKPPN F, ;FOR SAIL, USE THE DSKPPN (ALIAS)
JRST OPEN3F
OPEN3E:
SA% MOVE F,[%LDSYS]
SA% GETTAB R,
SA% MOVE F,R70+1 ;ASSUME SYS: IS 1,,1 IF GETTAB FAILS
SA$ MOVE F,[SIXBIT \ 1 3\] ;IT'S [1,3] ON SAIL
OPEN3F: MOVEM F,F.RPPN(TT)
JRST OPEN3N
OPEN3M: MOVE D,F.DEV(TT) ;FOR THE TTY, JUST COPY THE DEVICE NAME
MOVEM D,F.RDEV(TT)
OPEN3N:
] ;END OF IFN D10
IFN D20,[
MOVE T,F.DEV(TT)
CAME T,[ASCII \TTY\] ;SKIP IF OPENING *THE* TTY
JRST OPEN3D
MOVEI 1,.PRIIN ;CONSIDER USING THE PRIMARY JFN
TLNE TT,TTS.IO ; OF THE APPROPRIATE DIRECTION
MOVEI 1,.PRIOU
; GTSTS ;MAKE SURE IT IS OPEN
; JUMPGE 2,OPEN3D .SEE GS%OPN
; MOVSI D,(GS%RDF+GS%NAM) ;MAKE SURE IT CAN DO THE KIND OF I/O WE WANT
; TLNE TT,TTS.IO
; MOVSI D,(GS%WRF+GS%NAM)
; TDC 2,D
; TDCN 2,D
MOVE T,(FXP) ;RESTORE FLAG BITS
JRST OPEN3E
;HERE TO ALLOCATE A FRESH JFN AND OPEN THE FILE
OPEN3D: PUSH FXP,TT ;SAVE THE TTSAR
MOVEI T,F.DEV(TT)
HRLI T,-L.F6BT
PUSH FXP,(T) ;COPY THE GIVEN DEVICE NAMES ONTO THE STACK
AOBJN T,.-1
PUSH P,[-1] ;SAY LONG NAMESTRING
PUSHJ P,6BTNS ;CONVERT TO A NAMESTRING IN PNBUF
POPI P,1
POP FXP,TT ;GET TTSAR
MOVE T,(FXP) ;RESTORE MODE BITS IN T
MOVSI 1,(GJ%ACC+GJ%SHT) .SEE .GJDEF
TRNE T,1
TLNE T,FBT.AP
TLOA 1,(GJ%OLD) ;FOR INPUT OR APPEND, WE WANT AN EXISTING FILE
TLO 1,(GJ%FOU+GJ%NEW) ;FOR OUTPUT, A NON-EXISTENT FILE
MOVE 2,PNBP
GTJFN ;GET A JFN
IOJRST 4,OPNLZ0
OPEN3E: MOVE 2,OPEN9C(T) ;GET OPEN MODE
TLNE T,FBT.AP ;APPEND MODE, SET APPEND, READ BITS, CLR WRITE
TRC 2,OF%APP+OF%WR+OF%RD
OPENF ;OPEN THE FILE
IOJRST 4,OPNLZR
HRRZM 1,F.JFN(TT) ;SAVE THE JFN IN THE FILE OBJECT
] ;END OF IFN D20
;FALLS THROUGH